perm filename CYCCAT.LSP[4,LMM] blob sn#037485 filedate 1973-05-06 generic text, type T, neo UTF8

(DEFPROP CYCCATFNS
 (CYCCATFNS MAKECAT
	    TRIVGRAPH
	    CHORDLENGTH
	    TRIVALENTCODES
	    (SETQ LASTNODE 0.)
	    (AND LOADING (SETQ CATALOG-LIST (MAKECAT TRIVALENTCODES))))
VALUE)

(DEFPROP MAKECAT
 (LAMBDA (TVC) (FOR NEW X IN TVC AS NEW J IS (CAR X) LIST (FOR NEW Y IN (CDR X) LIST (TRIVGRAPH J Y))))
EXPR)

(DEFPROP TRIVGRAPH
 (LAMBDA(J L)
  (PROG	(S X Y LL N)
	(SETQ LL L)
	(SETQ S (SINGLERING J))
	(SETQ X
	      (PROG (FOR-VALUE I)
		    (SETQ I J)
	       LOOP*1
		    (COND ((LESSP I 1.) (GO RETURN)))
		    (SETQ FOR-VALUE (CONS I FOR-VALUE))
	       NEXT*1
	       NEXT*I
		    (SETQ I (PLUS I -1.))
		    (GO LOOP*1)
	       RETURN
		    (RETURN FOR-VALUE)))
	(PROG (FOR-VALUE)
	 NIL
	 NIL
	 LOOP*1
	      (COND ((NOT X) (GO RETURN)))
	      (COND ((NOT L) (GO RETURN)))
	      (SETQ N (PLUS (CHORDLENGTH (CAR L)) (CAR X)))
	      (CONNECT (FINDCTE (CAR X) S) (FINDCTE N S))
	      (SETQ X (DELETE N X))
	 NEXT*1
	 NEXT*L
	      (SETQ L (CDR L))
	 NEXT*X
	      (SETQ X (CDR X))
	      (GO LOOP*1)
	 RETURN
	      (RETURN FOR-VALUE))
	(RETURN (STRUCTURE FROM S UGRAPH = (CONS J LL)))))
EXPR)

(DEFPROP CHORDLENGTH
 (LAMBDA(X)
  (CDR
   (SASSOC X (QUOTE ((A . 1.) (B . 2.) (C . 3.) (D . 4.) (E . 5.) (F . 6.) (G . 7.) (H . 8.) (I . 9.))) NIL)))
EXPR)

(DEFPROP TRIVALENTCODES
 (TRIVALENTCODES
  (2. (A))
  (4. (B B) (A A))
  (6. (B C B) (A A A) (A B B) (A C A) (C C C))
  (8. (B C C B)
      (B D D B)
      (C E C C)
      (A A A A)
      (A A B B)
      (A A C A)
      (A B C B)
      (A B D A)
      (A C D B)
      (A D D A)
      (A E B B)
      (A E C A)
      (B B B B)))
VALUE)

(SETQ LASTNODE 0.)

(AND LOADING (SETQ CATALOG-LIST (MAKECAT TRIVALENTCODES)))